




                   Programming With CLUE: An Extended Example






                                 Kerry Kimbrough




                                   Version 6.0
                                   July, 1989





                   Copyright (C) 1989 Texas Instruments Incorporated.                
                                                                                     
    Permission is granted to any individual or institution to use, copy, modify,
    and distribute  this  document,  provided  that  this complete copyright and
    permission notice is maintained, intact, in all copies.
                                                                                     
    Texas Instruments  Incorporated  provides  this  document  "as  is"  without
    express or implied warranty.





This document contains  detailed examples  of CLUE  programming, all  based on a
simple CLUE  program  and  the  set  of  contact  classes  used to implement it.
Complete sources for these examples may be found in clue/examples/menu.l Some of
the functions used are defined by CLX, the basic Common Lisp interface to the  X
Window System.

The example "application" program presents a simple pop-up menu consisting of  a
column of  strings:  a  title  string  followed  by  selectable menu items.  The
application program itself relies upon the following two types of contacts.

button
    A pointer-sensitive area containing a text label.  Moving the pointer cursor
    onto a button causes it to be highlighted with a rectangular border.  If the
    pointer cursor is  inside a  button, then  clicking any  pointer button will
    cause the button contact to be  selected.  That is, the :select  callback of
    the button is invoked.

menu
    A  shell  contact  which  contains  a  column  of  buttons.   A  menu  shell
    automatically fills in its content with a title-frame, which provides a menu
    title string;  and  a  choices  composite,  which  arranges and controls the
    selectable  button  items.   When  an   item  has  been  selected,   a  menu
    automatically "pops down" and then invokes its own :select callback.


In order to implement menu and button contacts, three other contact  classes are
shown.

title-frame
    A special composite which labels its single child with a title string.

choices
    A collection of items for selection.  Each child of a choices composite is
    regarded as a selectable item.  Therefore, a choices automatically defines a
    :select callback function for each of its children.  This callback allows a
    choices composite to report when a child has been selected and to record the
    selected child for future reference.

column
    A geometry manager composite which arranges its children in a single
    vertical column and ensures that all children have the same size.  The
    choices class is a subclass of column that uses column geometry management
    to lay out selectable items.


1. Writing A CLUE Application

The complete  application  program  is  the  function just-say-lisp shown below.
just-say-lisp has the  typical structure  of a  CLUE application,  consisting of
four steps.
        
    1. Open a connection to an X display server and create a contact-display.

    2. Initialize the user interface by creating a set of contacts.

    3. Enter an event loop to process user input.

    4. Terminate by leaving the event loop, destroying all contacts and closing
       the display server connection.


(defun just-say-lisp (host &optional (font-name "fg-16"))
  (let* ((display   (open-contact-display 'just-say-lisp :host host))
         (screen    (contact-screen (display-root display)))
         (fg-color  (screen-black-pixel screen))
         (bg-color  (screen-white-pixel screen))

         ;; Create menu
         (menu      (make-contact
                      'menu
                      :parent     display
                      :font       font-name
                      :title      "Please pick your favorite language:"
                      :foreground fg-color
                      :background bg-color))
         (menu-mgr  (menu-manager menu)))    
    
    ;; Create menu items
    (dolist (label '("Fortran" "APL" "Forth" "Lisp"))
      (make-contact
        'button
        :parent     menu-mgr
        :label      label
        :foreground fg-color))
       
    ;; Bedevil the user until he picks a nice programming language
    (unwind-protect
        (loop
          ;; Pop up menu at current pointer position
          (multiple-value-bind (x y) (query-pointer (contact-parent menu))
            (let ((choice (menu-choose menu x y)))
              (when (string-equal "Lisp" choice)
                (return)))))      

      (close-display display))))


1.1. Creating A Contact Display

The open-contact-display function creates a  connection to the X  display server
named by the :host argument.  A contact-display representing this  connection is
returned.

  (let* ((display   (open-contact-display 'just-say-lisp :host host))
         (screen    (contact-screen (display-root display)))
         (fg-color  (screen-black-pixel screen))
         (bg-color  (screen-white-pixel screen))

The only required argument to open-contact-display is a display name symbol (for
example, just-say-lisp).   This  symbol  acts  as  a  name for a specific server
connection.   However,  since  an  application  typically  uses  only  a  single
contact-display, the display  name generally  serves as  a name  for the  entire
application.  As an  application name,  a display  name is  used primarily  as a
top-level component  in  resource  names.   See  Section 5.1 for examples of how
resources are used.  A display name may also be used by a window manager client.
For example, the name of a  contact-display is used to initialize  the :wm_class
property of  all  its  shells;  some  window  managers  may  choose to show this
property in window  title bars.   Some window  managers may  also allow users to
specify application properties  as window  manager resources,  using the display
name as a component in resource names.

Several functions  in  CLUE  and  CLX  operate  on a contact-display in order to
access various attributes of the display server.  For example, the  display-root
function returns a  root contact  corresponding to  a display  screen.  A screen
object, in turn, may  be accessed to  determine screen-specific attributes  (for
example, the  pixel  values  corresponding  to  black  and white in the screen's
default colormap).

1.2. Creating Contacts

The make-contact function is used to create an instance of a  particular contact
class.
         ;; Create menu
         (menu      (make-contact
                      'menu
                      :parent     display
                      :font       font-name
                      :title      "Please pick your favorite language:"
                      :foreground fg-color
                      :background bg-color))

make-contact has two  required arguments  --- the  name of  contact class  (e.g.
menu) and the parent of the new contact (given by the :parent keyword argument).
For convenience,  a  contact-display  may  be  given  as  the  :parent;  this is
equivalent to setting the :parent to (display-root display).

If the :parent is a  contact-display or a root,  then the new contact  will be a
"top-level  contact."   All   top-level   contacts   should   be   instances  of
override-shell, top-level-shell, top-level-session, or one of their  subclasses.
(In the example  above, menu  is a  subclass of  override-shell.) These  classes
implement the  special  behavior  required  of  top-level  X windows in order to
interact properly  with  window  managers  and  session managers.  CLUE does not
prevent programs from creating a  non-shell top-level contact, but  the behavior
of such contacts may be unpredictable.

Other arguments  to  make-contact  are  initargs which initialize class-specific
attributes.  The default values for initargs depend on the implementation of the
contact class.  Typically, most initargs correspond to contact resources.   When
resource initargs are omitted, then a default value may be read from a  resource
database initialized by  an individual  user.  A  good practice  for application
programmers is to minimize the number of initargs set in the program and thus to
increase the ability  of a  user to  fine-tune the  user interface  with his own
resource preferences.

Note that in the just-say-lisp example, the menu and button contacts are created
without initializing their  position or  size.  The  reason is  that all contact
geometry is computed  automatically.  The  size and  position of  each button is
determined partly by the font  and string used for  its label and partly  by the
geometry management policy provided by  its parent.  The button  parent returned
by the menu-manager function is a choices composite created automatically by the
menu shell.  Similarly, the  size of the  menu is determined  from the size  and
layout of the buttons it contains.



1.3. The Event Loop

In the main  body of  the just-say-lisp  function, the  menu-choose function  is
called repeatedly.  menu-choose presents the menu at a specified location, waits
for the user  to make  a selection,  then returns  the selected  item.  The  CLX
function query-pointer is used to  determine the current pointer  position where
the menu will appear.
 
        (loop
          ;; Pop up menu at current pointer position
          (multiple-value-bind (x y) (query-pointer (contact-parent menu))
            (let ((choice (menu-choose menu x y)))
              (when (string-equal "Lisp" choice)
                (return))))) 

menu-choose, which contains the program event  loop, is shown below.  Note  that
the event  loop  is  terminated  when  an  item  is  selected  by a throw to the
:menu-selection  tag.   add-callback  is  used  to  program  the  menu's :select
callback to invoke the throw.  This is done by defining the throw-menu-selection
function as the :select callback function.

  (defun menu-choose (menu x y)
    "Present the MENU at the given location and return the label of the
  item chosen. If no item is chosen, then nil is returned."
  
    ;; Set menu callback to return chosen item label
    (add-callback menu :select 'throw-menu-selection menu)
  
    ;; Display the menu so that first item is at x,y.
    (menu-present menu x y)
  
    ;; Event processing loop
    (catch :menu-selection
      (loop (process-next-event (contact-display menu)))))
  
  
  (defun throw-menu-selection (menu)
    "Throw to :menu-selection tag, returning the label of the selected menu button (if any)."
    (let ((selection (choice-selection (menu-manager menu))))
      (throw :menu-selection
             (when selection (button-label selection)))))
  

Note that  another  program  could  change  many  aspects of the menu's behavior
simply by defining a different :select  callback function.  For example, a  menu
selection might cause another function to be executed without exiting the  event
loop.  Also, the value corresponding to  a selected menu item could  be computed
differently, rather than simply returning the item button label string.


1.4 Managing Contacts

menu-choose calls the function  menu-present in order  to display the  menu at a
given location.

  (defun menu-present (menu x y)
    "Present the MENU with the first item centered on the given position."
    ;; Complete initial geometry management before positioning menu
    (unless (realized-p menu)
      (initialize-geometry menu))
  
    (let ((parent  (contact-parent menu))
          (item    (first (composite-children (menu-manager menu)))))
      
      ;; Compute the y position of the center of the first item
      ;; with respect to the menu
      (multiple-value-bind (item-x item-y)
          (contact-translate item 0 (round (contact-height item) 2) menu)
        (declare (ignore item-x))
  
        ;; Try to center first item at the given location, but
        ;; make sure menu is completely visible in its parent  
        (change-geometry
          menu
          :x (max 0 (min (- (contact-width parent) (contact-width menu))
                         (- x (round (contact-width menu) 2))))
          :y (max 0 (min (- (contact-height parent) (contact-height menu))
                         (- y item-y)))
          :accept-p t)))
    
    ;; Make menu visible
    (setf (contact-state menu) :mapped))


menu-present demonstrates several CLUE features used by application  programmers
to manage contacts.   The (setf  contact-state) function  is used  to manage the
menu's visual state.  The functions initialize-geometry and change-geometry  are
used to manage menu geometry.

(setf contact-state) is the function that changes the visual state of the  menu.
Setting the state  to :mapped  causes the  menu to  be displayed  at its current
position.  Actually, mapping the menu causes  the X server to send  an :exposure
event for  the  menu.   Then,  inside  the  process-next-event  loop,  when CLUE
receives this event, the menu display method is called automatically.

change-geometry is called to move the  menu to the current pointer  position ---
that is, to change the x  and y position of the  upper left corner of the  menu.
change-geometry actually requests approval for a geometry change from the parent
of the  menu.   The  actual  effect  of  change-geometry depends on the parent's
geometry management policy.  Later examples describe geometry management in more
detail.  In  this  case,  the  :accept-p  argument  to  change-geometry is true,
indicating that the new position determined by the parent's geometry  management
will be used.

initialize-geometry is  a  special  function  that  is  not  used  by  most CLUE
programs.  By invoking the  process of geometry  management, initialize-geometry
causes the  initial  geometry  for  the  menu  and  all of its descendants to be
computed before they are actually realized.  Ordinarily, initialize-geometry  is
called automatically just before a composite is realized; realizing the  contact
is also a step that is usually invoked automatically just before the event  loop
begins.  But the menu is a special case.  Why?

Note that  in  order  for  menu-present  to  pop  up  the  menu over the pointer
position, the initial size  of the menu  must be known  before the menu  becomes
:mapped.  Recall that the final  menu size depends on  the number of items,  the
size of the  item labels,  etc.  and  that computing  the initial  size involves
geometry management.  For most contacts, this initial geometry management can be
performed automatically simply by ensuring  that the contact is  "managed", i.e.
neither :mapped nor  :withdrawn.  But,  because the  menu is  an instance  of an
override-shell, it cannot be managed until it :mapped.  What is needed is a  way
to compute the initial  geometry management for  the menu before  it is managed.
That is the special purpose of initialize-geometry.  Note that after the menu is
realized, initialize-geometry is no longer necesssary.


1.5. Terminating the Program

The just-say-lisp program ends when the user selects the "right" item.  The  CLX
close-display function is called to close the connection to the X server.   This
also causes the menu and all other server resources created for this display  to
be destroyed.

    (unwind-protect
        (loop
          ...
          )      

      (close-display display))

A good programming practice illustrated by  just-say-lisp is to place the  event
loop inside  an  unwind-protect  form  and  to  include  close-display among the
cleanup forms.  Without  this protection,  an unexpected  error could  cause the
program to terminate without  freeing the server  resources it has  created.  If
server resources  are  repeatedly  created  without  being destroyed, then the X
server will eventually run out of memory and fail.


2. Implementing A Menu

This section  looks  at  the  CLUE  features  used  by  a  contact programmer to
implement the menu contact class.

2.1 Defining a Contact Class

The menu class is defined by a defcontact form which specifies its superclasses,
its slots, and its resources.

    (defcontact menu (override-shell)           ; A subclass of override-shell with...
      ()                                        ; ...no additional slots, and...
      (:resources
        (font       :type     font)             ; ... class resources, and...
        (foreground :type     pixel)
        (title      :type     string)
           
        (state      :initform :withdrawn))      ; ...a different default state
      
      (:documentation
        "Presents a column of menu items."))

The syntax of defcontact  is very similar  to that of  defclass.  The difference
lies in the resource specifications which  are special to CLUE contact  classes.
Resource specifications declare contact initargs that can be initialized from  a
resource database.  For example, the resource specifications for menu mean  that
a :font initarg can be given to  make-contact when creating a font and  that the
default value for :font can found in the resource database.  The :type given for
the menu  font  resource  means  that  the  :font  value  will  automatically be
converted to the 'xlib:font type.  Resource type conversion involves the convert
function, which is discussed later.

A subclass also inherits resource specifications from its superclasses.  In this
case, the menu class  inherits the state  resource from the  basic contact class
but assigns it a different default value of :withdrawn .  In other words, a menu
will not automatically become  :mapped by default  like most contacts  (instead,
this is done later by  menu-present after the menu  has been moved to  the right
position).  Note that to modify an inherited resource, it is sufficient to  list
only the changed part of its resource specification.

2.2. Class Initialization

The initialize-instance function  is part  of the  standard CLOS  initialization
protocol invoked by make-contact.  A contact programmer will typically define an
:after method for initialize-instance in  order to implement any  class-specific
initializations.  The  :after  method  for  the  menu  class creates most of the
pieces used  to  construct  a  menu  automatically.   As  a  result, application
programs do not need to be aware of the details of the menu contact hierarchy.

    (defmethod initialize-instance :after
      ((menu menu) &key title font foreground background &allow-other-keys)
      
      ;; Create title-frame containing choices child to manage menu items
      (let* ((title   (make-contact
                        'title-frame
                        :parent     menu
                        :name       :title
                        :text       title
                        :font       font
                        :foreground foreground
                        :background (or background :white)))
             
             (manager (make-contact
                        'choices
                        :parent       title
                        :name         :manager
                        :border-width 0)))
    
        ;; Define callback to handle effect of selection
        (add-callback manager :select 'popup-menu-select menu)
    
        ;; Moving pointer off menu causes nil selection
        (add-event manager
                   '(:leave-notify :ancestor :nonlinear)
                   '(choice-select nil))))
    
    
    
When a menu is returned from make-contact, it contains a title-frame showing the
menu title.  In turn, the title-frame contains a choices composite known as  the
"menu manager".  Menu  items are  then created  by adding  children to this menu
manager.   This   hierarchy   structure   exploits   the   power   of  CLOS  and
object-oriented programming  to  provide  extra  implementation modularity.  The
functions for title  display, item  arrangement, and  overall menu  behavior are
handled by separate classes.  As a result, new types of menus to be  implemented
easily by substituting new classes for each of these functions.

Two other aspects  of the  menu are  also initialized  here upon  creation.  The
menu-manager, a choices composite,  uses the :select  callback to signal  when a
user has selected  an item.   Because the  menu class  implements a pop-up menu,
add-callback is  called  to  initialize  this  callback  with  a  function  that
implements the  "pop  down"  side  effect  of  selecting an item.  When the menu
manager's :select callback is invoked, the popup-menu-select function  withdraws
the menu before invoking  the application function  associated with the  :select
callback of the menu.

    (defmethod popup-menu-select ((menu menu))
      ;; Pop down immediately
      (setf (contact-state menu) :withdrawn)
      (display-force-output (contact-display menu))
    
      ;; Invoke menu callback
      (apply-callback menu :select))
    
In addition, add-event is  used to define  an event translation  that implements
another aspect  of  pop  menu  behavior.   The  details  of  defining this event
translation are shown in the next section.



2.3. Defining Event Translations

 
The following event translation, which is  attached to the menu manager,  causes
the manager's choice-select action  to performed whenever  the pointer is  moved
outside the menu manager.

        ;; Moving pointer off menu causes nil selection
        (add-event manager
                   '(:leave-notify :ancestor :nonlinear)
                   '(choice-select nil))
   

The argument  passed  to  the  choice-select  function  is  nil.   The item thus
selected is nil; that is, moving the  pointer off the menu to disappear  without
actually selecting an item (see Section 4.2, The Menu Manager, for a description
of of  choice-select).   Note  that  this  is an instance event translation that
applies only to  a specific  menu manager  instance.  An  alternative might have
been to use defevent to define  this event translation for all  instances of the
choices class.  However, this would assign "select nil when leaving" behavior to
all choices  contacts;  using  an  instance  translation instead allows the same
choices class to be used in cases where this behavior is is not desirable.

Like any X window, a  contact must select the  types of events that  it wants to
receive and process.  The event-mask slot contains a bit string representing the
events selected for  a contact.   But CLUE  programs rarely  need to  access the
event-mask directly.  For example, this call to add-event automatically  updates
the menu manager's event-mask to select :leave-notify events.

The event specification  syntax used  here is  an extension  to the  basic event
specifications provided by  CLUE.  The  extension defines  a new  type of  event
specification of the form  (:leave-notify kind*), where  each kind is  a keyword
identifying a kind  of :leave-notify  event.  This  type of  event specification
will match a :leave-notify event if the event is one of the specified kinds.   A
contact programmer creates this  new type of  event specification by  defining a
check function and a match functon.

    (defun leave-check (event-key &rest kinds)
      (dolist (kind kinds)
        (unless (member kind '(:ancestor :virtual :inferior :nonlinear :nonlinear-virtual))
          (error "~s isn't a valid kind of ~s event" kind event-key)))
      (list 'leave-match kinds))
    
    (defun leave-match (event kinds)
      (member (slot-value event 'kind) kinds :test #'eq))
    
    (setf (check-function :leave-notify) 'leave-check)

The check-function set  for the  :leave-notify event  type is  leave-check.  The
arguments to leave-check are the elements of the event-specification list --- an
event type keyword and a set of event kind keywords.  After verifying that  only
valid kinds are specified, leave-check returns a list containing the leave-match
function and the "canonical form" of the event specification.  Inside the  event
loop, leave-match will be called to  compare an input event with  this canonical
form.  leave-match reports a  match when the  event is a  :leave-notify event of
one of the kinds specified by the canonical event specification.


3. Implementing A Button

This section  looks  at  the  CLUE  features  used  by  a  contact programmer to
implement the button contact class.


3.1 Slot Resources

A button is  a non-composite  contact with  a set  of attributes  represented by
slots --- a  text label  plus a  font and  a foreground  color used  to draw the
label.  All  of  these  attribute  slots  are  also declared as resources.  As a
result, when an  instance of  a button  is created,  CLUE automatically converts
values given  for  these  resource  slots  to the specified representation type.
This applies  not  only  to  initarg  values  given  to make-contact but also to
default values found  in the  resource database  or in  resource initforms.  For
example, the default initform for the font slot is the font name "fg-16"  which,
if used, is automatically converted to a font object via the open-font function.
Similarly, the default foreground value of :black is automatically converted  to
an appropriate pixel value using  screen-black-pixel.  CLUE defines a  number of
built-in convert methods  that can  convert among  commonly-used representations
for X objects like fonts, pixels, pixmaps, and images.  Programmers are free  to
extend this mechanism by defining their own convert methods.

    (defcontact button (contact)
      
      ((label
         :accessor   button-label
         :initarg    :label
         :initform   ""
         :type       string)
    
       (font
         :accessor   button-font
         :initarg    :font
         :initform   "fg-16"
         :type       font)
    
       (foreground
         :accessor   button-foreground
         :initarg    :foreground
         :initform   :black
         :type       pixel)
    
       (compress-exposures
         :allocation :class
         :initform   :on
         :reader     contact-compress-exposures
         :type       (member :off :on)))
      
      (:resources
        (background :initform :white)
        (border     :initform :white)
        font
        foreground
        label)
      
      (:documentation
        "Triggers an action."))


Notice also that several slots inherited  from the base contact class  are given
new default values for  the button class.   The background and  border resources
for buttons default  to :white.   The compress-exposures  slot defaults  to :on.
Thus, :exposure events for buttons are "compressed" --- all but the final member
in  a  sequence  of  button  :exposure  events  are  discarded.   Why?   Because
displaying a button contact is a simple matter of drawing its text label, it  is
more efficient  to  draw  the  whole  string  at  once  than  it is to draw each
individual exposed piece.  event-compress is  a class slot and  therefore cannot
be a resource;  its new  default value  for the  button class  must therefore be
defined in a slot specification instead of a resource specification.

Of course, class resources need not  be represented as slots.  For  example, the
defcontact form for the menu class shown earlier declares non-slot resources for
font, foreground  color,  and  title  string.   Non-slot  resources  values  are
contained in the  argument list  to initialize-instance.   As shown  earlier for
menu,  non-slot   resources   are   typically   used   in   :after  methods  for
initialize-instance to initialize other components of a contact instance.


3.2 Displaying a Contact
    
Every class of contacts that contains something to display must define a  method
for the display function.   CLUE automatically invokes  this method whenever  an
:exposure event for the contact is processed.  Some contact classes do not  need
a display method.  For example, by default, composite subclasses do not  receive
:exposure events because all displayable  information is typically contained  in
the children.

The display  method  for  the  button  class  is shown below.  Because :exposure
events are  compressed,  this  method  displays  the  entire button contents and
ignores the x, y, width, and height arguments which define the region exposed.
    
    (defmethod display ((button button) &optional x y width height &key)
      (declare (ignore x y width height))
      
      (with-slots
        (font label foreground (button-width width) (button-height height))
        button
        
        ;; Get metrics for label string
        (multiple-value-bind (label-width ascent descent left right font-ascent font-descent)
            (text-extents font label)
          (declare (ignore ascent descent left right))
    
          ;; Center label in button
          (let ((label-x (round (- button-width label-width) 2))
                (label-y (+ (round (- button-height font-ascent font-descent) 2)
                            font-ascent)))
    
            ;; Use an appropriate graphics context from the cache
            (using-gcontext (gc :drawable   button
                                :font       font
                                :foreground foreground)
              (draw-glyphs button gc label-x label-y label))))))

Note that using-gcontext  is used  to find  a graphics  context for  drawing the
label  characters.   using-gcontext  searches  a  cache  of   previously-created
gcontext objects, locates one with the given font and foreground attributes, and
binds it to the symbol gc for use with the draw-glyphs function .  The advantage
of using-gcontext is that  the total number  of gcontext objects  created by the
program can be minimized.   Saving a gcontext  with each button  instance is not
required, and slots are  allocated only for  the individual gcontext  components
used.  The disadvantage of using-gcontext  is that searching the  gcontext cache
makes displaying somewhat slower.
    

3.3 Defining a Preferred Size

A button is not a  composite and therefore does  not act as a  geometry manager.
However, a  non-composite  class  can  play  a  part  in  geometry management by
defining a preferred size.  Some geometry managers will call the  preferred-size
function to ask for a child's advice about its best size.  Therefore, defining a
preferred-size  method  for  each  contact  class  is  a  good  practice.    The
preferred-size method for the button class is shown below.

    (defmethod preferred-size ((button button) &key new-width new-height new-border-width)
      (with-slots (font label border-width) button
        
        ;; Get metrics for label string
        (multiple-value-bind (label-width ascent descent left right font-ascent font-descent)
            (text-extents font label)
          (declare (ignore ascent descent left right))
    
          (let* ((margin      2)
                 (best-width  (+ label-width margin margin))
                 (best-height (+  font-ascent font-descent margin margin)))
    
            ;; Return best geometry for this label
            (values
              (if new-width  (max new-width best-width)   best-width)
              (if new-height (max new-height best-height) best-height)
              (or new-border-width border-width))))))

For a button,  the preferred  size returned  is one  big enough  to contain  the
entire label string,  including a  margin of  two pixels  around all sides.  The
:new-width and :new-height  arguments give  the size  suggested by  the geometry
manager; if it is big enough, then  this suggested size is returned.  Note  that
the border width of the button is unimportant; this method simply returns either
the suggested value or the current value for border width.

3.4 Handling Contact Input

A button is  a simple  contact that  responds to  user input  in just  two ways.
Moving the pointer  cursor onto  a button  causes it  to be  highlighted with  a
rectangular border.  If the pointer cursor is inside a button, then clicking any
pointer button will cause  the button contact  to be selected.   These responses
are  implemented   by   two   action   functions   ---  button-set-highlight and
button-select.

button-set-highlight highlights  or  unhighlights  the  button, depending on the
on-p argument.  If on-p is true, then  the button is highlighted by drawing  its
border in  the  foreground  color;  otherwise,  the  button  is unhighlighted by
drawing its border in the background color.
    
    (defmethod button-set-highlight ((button button) on-p)
      (with-slots (foreground background) button
        (setf (window-border button) (if on-p foreground background))))

button-select simply invokes the :select callback of the button.  The effect  of
this depends on the callback function actually associated with :select.
    
    (defmethod button-select ((button button))
      (apply-callback button :select))

Notice that the responses performed by these actions are not necessarily related
to any specific type of input event.  For each action, an event translation must
be established that  will connect  the action  with the  event that triggers it.
The button  class  uses  the  following  class  event translations to make these
connections.  Like add-event, defevent causes  the event-mask of each  button to
select :button-press, :enter-notify, and :leave-notify event.
    
    (defevent button :button-press button-select)
    (defevent button :enter-notify (button-set-highlight t))
    (defevent button :leave-notify (button-set-highlight nil))
    
These class event translations  represent defaults that  might be overridden  by
more specific instance translations.   For example, the  event-translations slot
of a contact is declared as a resource.  This means that by defining a value for
event-translations in the  resource database,  a user  can initialize  a contact
with new  instance  translations  that  customize  the connections between event
types and actions.
    


4. Implementing the Menu Hierarchy

A menu consists of a hierarchy of contacts, each of which implements a  specific
part of a menu's behavior.  A contact class is defined for each part of the menu
hierarchy.

menu            A shell which acts as the the top-level container for the menu.
                Provides the application program interface for overall menu
                behavior. A menu has a title-frame as its only child.

title-frame     Implements the layout and display of the menu title. A
                title-frame contains a choices contact as its only child.

choices         The manager for menu items. Allows the application program
                to define menu items. Coordinates the selection of menu items.

column          Implements geometry management for a column of menu items.

Most parts of  the menu  hierarchy are  created automatically  when the  menu is
created (see Section 2.2, Class Initialization).  This section shows some of the
CLUE features used to implement these classes.


4.1 The Menu Title

A title-frame has slots that specify title text, font, and foreground color. 

    (defcontact title-frame (composite)
    
      ((font
         :accessor title-font
         :initarg  :font
         :initform "fg-16"
         :type     font)
    
       (foreground
         :accessor title-foreground
         :initarg  :foreground
         :initform :black
         :type     pixel)   
       
       (text
         :accessor title-text
         :initarg  :text
         :type     string)
    
       (compress-exposures
         :allocation :class
         :initform   :on
         :reader     contact-compress-exposures
         :type       (member :off :on)))
      
      (:resources
        font
        foreground
        text
        (event-mask :initform #.(make-event-mask :exposure)))
      
      (:documentation
        "A composite consisting of a text title and another contact."))


Unlike many composites, a title-frame  contains displayable information ---  the
title string.  This means  that a title-frame  must select :exposure  events and
must define a display method.  Defining  a new default value for  the event-mask
resource  accomplishes  the  necessary  modification  to  the  composite   class
defaults.  Note the use  of the CLX  function make-event-mask, which  converts a
sequence of event mask keywords  into a bit string.   The same thing might  have
been accomplished  by  using  defevent  to  define  a  title-frame  class  event
translation for :exposure events.  However, this approach is inefficient because
CLUE does not need such an event translation to handle :exposure events.


The following title-frame  methods allow  a title-frame  to change  its size and
title layout when necesssary.  For example, changing the title font to a  larger
size should cause the content of  the title-frame (i.e.  the choices  containing
menu items) to be moved slightly so that it does not cover up the title.

    (defmethod (setf title-font) (new-value (title-frame title-frame))
      (title-update title-frame :font (convert title-frame new-value 'font)))
    
    (defmethod (setf title-text) (new-value (title-frame title-frame))
      (title-update title-frame :text new-value))
    
    (defmethod title-update ((title-frame title-frame) &key text font)
      (with-slots ((current-text text) (current-font font)) title-frame
                
        ;; Update slots
        (setf current-text (or text current-text)
              current-font (or font current-font))
        
        ;; Update geometry
        (when (realized-p title-frame)
          (change-layout title-frame))))

Note that this method for (setf title-font) replaces the default method  created
by the font slot :accessor option.   (setf title-frame) also calls convert  with
the new font value  to handle conversion  to the necessary  representation type.
This allows a program to  specify the new font  either as a font  name string or
with a previously-opened font object.
    
title-update calls change-layout  to rearrange  the geometry  of the title-frame
and its  content.   change-layout  is  a  geometry  management  function that is
discussed later in more detail.


4.2  The Menu Manager

The choices class implements the functions of a menu manager:

        o   Serve as the parent for menu item contacts.

        o   Provide geometry management for menu items. The choices geometry
            management policy is inherited from its column superclass, which is
            described later.

        o   Coordinate menu item selection. 

        o   Record the currently-selected item.

The  choices   class   defines   a   single   selection   slot  to  contain  the
currently-selected item.  Note that only a  :reader is specified for this  slot;
selection should be done interactively by the user, not by the program.

    (defcontact choices (column)
    
      ((selection
         :reader   choice-selection
         :initform nil
         :type     (or null contact)))
      
      (:documentation
        "A column of items to choose from."))
    
Whenever a  contact  is  created,  the  add-child  function is called to add the
contact to  its  parent's  set  of  children.   The primary method for add-child
should not be modified,  but contact programmers  may define :after  methods for
add-child that perform  child initializations  required for  a specific  contact
class.   For  example,  the  add-child  :after  method  for  the  choices  class
initializes the :select callback for each menu item.

    (defmethod add-child :after ((choices choices) child &key)
      ;; Initialize child's :select callback
      (add-callback child :select 'choice-select choices child))
    
    
    (defmethod choice-select ((choices choices) child)
      ;; Record current selection
      (with-slots (selection) choices
        (setf selection child))
    
      ;; Invoke selection callback
      (apply-callback choices :select))

When initialized as  shown here,  the :select  callback for  each menu item will
call the choice-select  function with  the selected  item child  as an argument.
choice-select implements  the  choices  action  for  selecting  a  menu item; it
records the current selection and invokes  the :select callback for the  choices
menu manager.

4.3 Selection Callbacks

Menu selection relies upon :select callbacks  from three different parts of  the
menu hierarchy.

    Menu item       A menu item contact, such as a button, invokes its :select
                    callback in response to user input. The associated function
                    (choice-select) lets the menu manager know which item has
                    been selected.

    Menu manager    The choices menu manager allows only a single item to be
                    selected.  A choices contact invokes its :select callback
                    when an item is selected.  The associated function
                    (popup-menu-select) lets the menu know that it is time to
                    withdraw the pop-up menu.

    Menu            A menu invokes its :select callback when menu has been
                    withdrawn.  The associated function is defined by the
                    application program.  In menu-choose, the associated
                    function is throw-menu-selection, which terminates the event
                    loop and returns the label of the selected item.

This distribution of  selection control  means that  knowledge about  the entire
structure of the menu hierarchy  does not have to  be built into the  methods of
classes that  implement  menu  items  and  menu  managers.  It also provides the
flexibility to  implement  different  selection  policies.   For example, a menu
manager that allowed  more than  one item  to be  selected could  be substituted
easily.

4.4  Menu Geometry Management

choices is  a  subclass  of  the  column  class,  which  implements its geometry
management policy.

    (defcontact column (composite) ()
      (:documentation
        "Arranges its children in a vertical column."))

With no  slots  or  display  content  of  its  own,  column  is  a pure geometry
management class.  That is,  its purpose is  simply to provide  methods for CLUE
geometry management  functions.   Here  is  what  the column geometry management
policy does:

        o   Item size
                All items are made to have the same size, namely the preferred
                size of the largest item. 

        o   Item layout
                Items are arranged in a vertical column and separated by a bit
                of space. They are also positioned horizontally so that they are
                centered in the column, and their inside left and right edges are
                aligned. 

        o   Handling item geometry
                If the biggest item gets bigger, then all items are given the
                new size.  An item can request a change to its border width;
                this is allowed and it causes the item to move so that its
                inside edges remained aligned with other items.  Item position
                is completely determined by the order of the children list and
                the column policy; an item is not permitted to move itself
                directly.

        o   Handling menu geometry
                In trying to arrange its items, a column will compute the size
                needed for itself --- that is, a size big enough to contain all
                items with a nice spacing. The column must request this size from
                its geometry manager, then somehow deal with whatever approved
                size it is given. 

In the case of a  menu, the geometry manager  (i.e.  the parent) of  the choices
column is a title-frame.  This title-frame,  in turn, is managed by  its parent,
the menu shell.  When the choices column requests its size be changed (based  on
its policy  and  its  list  of  item  children),  then  its title-frame and menu
ancestors responds similarly.   For both  a title-frame  and menu,  the geometry
management policy is to be big enough to contain its content (the implementation
of this policy is not shown here).  As a result, the requested column size  gets
propagated back up  the menu  hierarchy until  every component  finds its  right
size.  In  this  way,  the  sizes  for  the  top-level  menu  and  all the other
intermediate contacts are computed automatically and do not need to be  assigned
by the application programmer.

The following  examples  show  how  the  geometry  management methods for column
implement this  policy.   The  method  for  change-layout  defines the effect of
adding or  deleting  a  new  column  item.   Also,  when  a  column  is created,
change-layout is called once to compute  the initial item layout.  In  CLUE, the
change-layout method  of  a  composite  is  called  whenever  its set of managed
children changes.

    (defmethod change-layout ((column column) &optional newly-managed)
      (declare (ignore newly-managed))
      (with-slots (width height) column
    
        ;; Compute the maximum preferred size of all children.
        (multiple-value-bind (item-width item-height)
            (column-item-size column)
    
          ;; Compute preferred column size, assuming this item size
          (multiple-value-bind (preferred-width preferred-height)
              (column-preferred-size column item-width item-height)
            
            ;; Try to ensure at least preferred size
            (if
              (or (setf preferred-width  (when (< width preferred-width)   preferred-width))
                  (setf preferred-height (when (< height preferred-height) preferred-height)))
              
              ;; Ask parent for larger size
              (change-geometry column
                               :width    preferred-width
                               :height   preferred-height
                               :accept-p t)
              
              ;; Else current size is big enough
              (column-adjust column item-width item-height))))))


First, the preferred column size is computed, based on the current set of items.
This is done using the functions column-item-size and column-preferred-size.


    (defun column-item-size (column)
      "Return the maximum preferred width and height of all COLUMN children."
      (with-slots (children) column
        (let ((item-width 0) (item-height 0))
          (dolist (child children)
            (multiple-value-bind (child-width child-height child-bw)
                (preferred-size child)
              (setf item-width  (max item-width  (+ child-width child-bw child-bw))
                    item-height (max item-height (+ child-height child-bw child-bw)))))
          (values item-width item-height))))
    
    
    (defun column-preferred-size (column item-width item-height)
      "Return the preferred width and height for COLUMN, assuming the given
       ITEM-WIDTH and ITEM-HEIGHT."
      (with-slots (children) column
        (let ((preferred-margin 8))
          (values
            (+ item-width preferred-margin preferred-margin)
            (+ (* (length children) (+ item-height preferred-margin))
               preferred-margin)))))


If the current column size is smaller  than its preferred size, then the  column
trys to expand.  The  column requests approval  from its geometry  manager for a
larger size  by  calling  change-geometry.   The  :accept-p  argument  given  to
change-geometry is true; that is, any modification to the requested change  made
by the geometry  manager is  accepted without  any further  negotiation.  If the
current column size  is at  least as  big as  its preferred  size, then  no size
change is  necessary.   In  this  case,  the  column simply rearranges its items
within its current dimensions by calling column-adjust.

    
    (defun column-adjust (column &optional item-width item-height)
      "Rearrange COLUMN items according to current COLUMN size. If given, ITEM-WIDTH
       and ITEM-HEIGHT define the new size for all items."
      (with-slots (children width height) column
        (when children
          ;; Compute preferred item size, if necessary
          (unless item-height
            (multiple-value-setq (item-width item-height)
              (column-item-size column)))
          
          ;; Compute item spacing
          (let* ((number-items (length children))
                 (margin       (max (round (- width item-width)
                                           2)
                                    0))
                 (space        (max (round (- height (* number-items item-height))
                                           (1+ number-items))
                                    0)))
            
            ;; Set size and position of each child
            (let ((y 0))
              (dolist (child children)
                (let ((bw (contact-border-width child)))
                  (with-state (child)
                    (resize child (- item-width bw bw) (- item-height bw bw) bw) 
                    (move child margin (incf y space))))
                (incf y item-height)))))))

The resize  and  move  functions  are  called  to  actually relocate each child.
Notice that these calls lie within a with-state form.  with-state is a CLX macro
that makes window reconfiguration more efficient  by combining the new size  and
position into a single request to the X server.  Calling resize and move here is
very important.  Many contact classes define :after methods for these  functions
in order to implement side-effects of geometry changes.  For example, resizing a
column causes it to rearrange all of its items within the new size.  The  column
resize method is called by change-geometry above when :accept-p is true.

    (defmethod resize :after ((column column) width height border-width)
      (declare (ignore width height border-width))
      (column-adjust column))


The  other   geometry   management   method   defined   by  column  is  for  the
manage-geometry function.  manage-geometry is called by change-geometry in order
to grant approval for  a change requested  by a column  item.  Implementing this
method is often  complicated.  A  column has  several factors  to consider  when
approving a change to an item.  First, no position change can be approved if  it
differs from the position already determined by column policy.  Also, an item is
not allowed to shrink because it must maintain the same (maximum) size preferred
by all other items.  (A more complex policy implementation might allow items  to
shrink, resetting all items to any new maximum size.) On the other hand, if  the
requested item change  does not  affect its  overall width  and height, then the
change can be approved immediately.
    
    (defmethod manage-geometry ((column column) child x y width height border-width &key)
      (with-slots
        ((child-width width)
         (child-height height)
         (child-border-width border-width)
         (child-x x)
         (child-y y))
        child
    
        (let*
          ;; No position change can be approved.
          ((position-approved-p     (not (or (unless (null x) (/= x child-x))
                                             (unless (null y) (/= y child-y)))))
           
           ;; Check if requested size change can be approved.
           (total-width            (+ child-width child-border-width child-border-width))
           (total-height           (+ child-height child-border-width child-border-width))
           (requested-width        (or width child-width))
           (requested-height       (or height child-height))
           (requested-border-width (or border-width child-border-width))
           (new-total-width        (+ requested-width requested-border-width requested-border-width))
           (new-total-height       (+ requested-height requested-border-width requested-border-width)))
    
          ;; Refuse size change immediately if it reduces item size
          (when (or (< new-total-width total-width) (< new-total-height total-height))
            (return-from manage-geometry
              nil
              child-x
              child-y
              (- child-width requested-border-width requested-border-width)
              (- child-height requested-border-width requested-border-width)                 
              requested-border-width))
    
          ;; Approve size change immediately if it does not affect item size
          (when (and (= new-total-width total-width) (= new-total-height total-height))     
            (return-from manage-geometry
              position-approved-p 
              child-x
              child-y
              requested-width
              requested-height
              requested-border-width))
    
          ;; Otherwise, a larger item size has been requested.
          ;; Check if column size can be enlarged sufficiently.
          (multiple-value-bind (column-width column-height)
              (column-preferred-size column new-total-width new-total-height)
    
            ;; Request change to preferred column size
            (multiple-value-bind
              (approved-p approved-x approved-y approved-width approved-height)
                (change-geometry column :width column-width :height column-height)
              (declare (ignore approved-x approved-y))
             
              (when approved-p
                
                ;; Larger column size approved.
                ;; When requested child geometry approved, change column layout to reflect new
                ;; item size(s). Change child size here first before recomputing item layout.
                (when position-approved-p         
                  (with-state (child)
                    (resize child requested-width requested-height requested-border-width))
                  (change-geometry column :width column-width :height column-height :accept-p t))
                
                (return-from manage-geometry
                  position-approved-p 
                  child-x
                  child-y
                  requested-width
                  requested-height
                  requested-border-width))
              
              ;; Larger column size NOT approved. Return best item size that could fit
              ;; approved column size
              (return-from manage-geometry
                nil
                child-x
                child-y
                (- approved-width requested-border-width requested-border-width)
                (- (floor approved-height (length (composite-children column)))
                   requested-border-width requested-border-width)
                requested-border-width))))))
    

What if an item asks to become bigger?  In this case, the column itself may need
to expand, so the  manage-geometry method for  column begins a  negotiation with
the column's geometry manager.  A call to changed-geometry returns the  approval
from the column geometry manager.  If approved, the column grows to fit the  new
item  size  and  returns  its  own  approval  for  the  changed   item geometry.
Otherwise,  the  column  is  forced  to   refuse  the  larger  item  size,   but
manage-geometry returns the best item size possible for the column size granted.

5. Using Resources

This section  shows  how  the  resource  database  can  be  used  to  modify the
appearance and  behavior  of  an  application  user  interface, without actually
modifying.  the application program.  Resources  offer users a way  to fine-tune
an application user interface in  ways that application programmers  and contact
programmers may not have anticipated.

Resources allows  user  and  programmers  to  cooperate  in  defining  the  user
interface.   Contact  programmers  declare  which  contact  attributes  may   be
specified as  resources,  by  giving  the  appropriate  resource declarations to
defcontact.  Application programmers, who instantiate contacts, can also control
user access to  resource values.   The application  program can  either set  the
resource value initarg to make-contact, or it can leave it to be defaulted  from
the resource database.   Finally, users  can invoke  define-resources to provide
default resource values which suit their preferences.

In order to demonstrate  how resources are  used, the resource-menu  function is
defined.  Similar to  the just-say-lisp  function, resource-menu  creates a menu
containing the  given  items,  displays  the  menu  at the pointer position, and
returns  the   user's   choice.    resource-menu   uses  the  :name  argument to
make-contact to assign resource names to the menu and each item.  The  :defaults
argument to  make-contact  is  also  used  to  pass  along  application-specific
resource defaults.


    (defun resource-menu (host menu-name item-defaults &rest buttons)
      (let*
        ((display (open-contact-display 'resource-menu :host host))         
         (menu    (make-contact 'menu :parent display :name menu-name)))    
        
        ;; Create menu items
        (dolist (label buttons)
          (make-contact 'button
                        :parent   (menu-manager menu)
                        :name     (intern (string label))
                        :label    (format nil "~:(~a~)" label)
                        :defaults item-defaults))    
        
        ;; Set menu callback to return chosen item label
        (add-callback menu :select 'throw-menu-selection menu)
        
        ;; Display the menu so that first item is at x,y
        (initialize-geometry menu)
        (multiple-value-bind (x y) (query-pointer (contact-parent menu))
          (menu-present menu x y))
        
        ;; Event processing loop
        (let ((selected (catch :menu-selection
                          (loop (process-next-event display)))))
          
          ;; Close server connection
          (close-display display)
          
          ;; Return selected string
          selected)))


5.1 Defining Resources

The  beatlemenuia   function   contains   several   examples   of   the  use  of
define-resources.  beatlemenuia itself is simply  a wrapper which allows  one to
set the value  of the  X server  host and  to experiment  with different sets of
resource defaults for menu items.

    (defun beatlemenuia (host &optional defaults)
      ;; ... examples of define-resources ...
      )
    
    
Inside beatlemenuia, define-resources  is called  to store  resource bindings in
the resource database.

    ;;;----------------------------------------------------------------------------+
    ;;;                                                                            |
    ;;;                                 Example 1                                  |
    ;;;                                                                            |
    ;;;----------------------------------------------------------------------------+

    (define-resources
      (* beatles title) "Who is your favorite Beatle?")

In Example 1, define-resources  binds the resource  name (* beatles  title) to a
specific value --- the string "Who is your favorite Beatle?" --- and stores this
resource binding  in  the  resource  database  given  by  the  special  variable
*database*.  The meaning of this resource  binding is that title string  for the
contact named beatles should be "Who is your favorite Beatle?" and that  beatles
may appear anywhere in the contact hierarchy.  Now, if an application creates  a
menu named beatles without specifying its title, then this default title  string
will be read from *database* and used.

By default, CLUE establishes a top-level  binding for *database*, binding it  to
an empty  resource-database  object.   The  basic  functions  for  creating  and
manipulating a  resource-database  are  defined  by  CLX.   An  application  may
manipulate several resource databases, in  which case the binding  of *database*
needs to be carefully  controlled by both  the program and  its users when using
resources.

Example 2  defines  resource  bindings  for  button  foreground, background, and
border resources.  Note that a resource name may include the name of a class  of
contacts, as well as  the name of  a specific contact  instance.  In Example  2,
resource-menu displays a  menu in  which the  buttons are  black rectangles with
white labels.  As a result of Example 1, the title of this menu is "Who is  your
favorite Beatle?".

    ;;;----------------------------------------------------------------------------+
    ;;;                                                                            |
    ;;;                                 Example 2                                  |
    ;;;                                                                            |
    ;;;----------------------------------------------------------------------------+
    
        (format t "~%Buttons are white-on-black ...")
        
        (define-resources (* button foreground) :white
                          (* button background) :black
                          (* button border)     :white)
        
        (format t " Choice is ~a"
                (resource-menu host 'Beatles defaults 'John 'Paul 'George 'Ringo))
        
        (undefine-resources (* button foreground) :white
                            (* button background) :black
                            (* button border) :white)
        (unless (y-or-n-p "~%Continue?") (return))

After  resource-menu  returns,  undefine-resources  is  called  to  remove   the
previously-stored  resource   bindings   from   *database*.    For  convenience,
undefine-resources has the same argument list as define-resources; however, only
the resource names are significant, and the resource values are ignored.

Example 3 demonstrates the  use of the  display resource name  and the power  of
"wild-card" matching for  resource names.   The resource  name (resource-menu  *
font) matches the font resource for  any contact belonging to the  display named
resource-menu.  As a result, the menu title and button labels all appear in  the
given font.  Note that the font value is specified as a font name  string.  When
a contact is created and its font resource value is read from the database, then
the convert function automatically converts the  given name string into an  open
font object.
    
    ;;;----------------------------------------------------------------------------+
    ;;;                                                                            |
    ;;;                                 Example 3                                  |
    ;;;                                                                            |
    ;;;----------------------------------------------------------------------------+
    
        (format t "~%Use font FG-22 everywhere ...")
        
        (define-resources (resource-menu * font) "fg-22")
        
        (format t " Choice is ~a"
                (resource-menu host 'Beatles defaults 'John 'Paul 'George 'Ringo))
        
        (undefine-resources (resource-menu * font) "fg-22")
        (unless (y-or-n-p "~%Continue?") (return))    
    
    
Example 4 shows another "wild-card" resource name used to specify the background
pattern for  all  components  of  the  contact  named  beatles.   The pattern is
specified as a gray-scale  value between 0.0  and 1.0.  CLUE  defines a built-in
convert method that converts the value 0.8 into a two-color background pixmap in
which approximately 80% of the pixels are 1 and 20% are 0.

    ;;;----------------------------------------------------------------------------+
    ;;;                                                                            |
    ;;;                                 Example 4                                  |
    ;;;                                                                            |
    ;;;----------------------------------------------------------------------------+
    
        (format t "~%Use gray background in menu ...")
        
        (define-resources (* beatles * background) 0.8)
        
        (format t " Choice is ~a"
                (resource-menu host 'Beatles defaults 'John 'Paul 'George 'Ringo))
        
        (undefine-resources (* beatles * background) 0.8)
        (unless (y-or-n-p "~%Continue?") (return))

    
In Example 5, resource bindings are given for specific menu items.  The resource
names therefore contain contact name symbols such as 'John and 'Ringo.  Only the
matching menu  items  are  affected.   Note  also  that a background resource is
specified with the name of  a bitmap image predefined  by CLUE.  CLUE defines  a
built-in convert method to convert image names into a corresponding pixmap.

    
    ;;;----------------------------------------------------------------------------+
    ;;;                                                                            |
    ;;;                                 Example 5                                  |
    ;;;                                                                            |
    ;;;----------------------------------------------------------------------------+
    
        (format t "~%Only John uses font FG-22, Ringo uses gray background ...")
        
        (define-resources (* John font)        "fg-22"
                          (* Ringo background) "50%gray")
    
        (format t " Choice is ~a"
                (resource-menu host 'Beatles defaults 'John 'Paul 'George 'Ringo))
    
        (undefine-resources (* John font)        "fg-22"
                            (* Ringo background) "50%gray")    
        (unless (y-or-n-p "~%Continue?") (return))
    
    
In Example 6,  resources are  used to  modify not  the visual  appearance of the
button but rather  its interactive  behavior.  The  basic contact class declares
the  event-translations   slot   as   a   resource.   Therefore,  instance event
translations for any contact  can be specified  in the resource  database.  Menu
item buttons  created  in  Example  6  can  be selected only by pressing pointer
:button-3 (by default, the right pointer button).  :button-press events from the
other two  pointer  buttons  are  translated  to  the  ignore-action.  This is a
generic action function defined by  CLUE; the primary ignore-action  method uses
the CLX bell function to "beep" the X server display.

    ;;;----------------------------------------------------------------------------+
    ;;;                                                                            |
    ;;;                                 Example 6                                  |
    ;;;                                                                            |
    ;;;----------------------------------------------------------------------------+
    
        (format t "~%Select only with :button-3 ...")
        
        (define-resources (* button event-translations)
                          '(((:button-press :button-3) button-select)
                            ((:button-press :button-1) ignore-action)
                            ((:button-press :button-2) ignore-action)))
        
        (format t " Choice is ~a"
                (resource-menu host 'Beatles defaults 'John 'Paul 'George 'Ringo))
        
        (undefine-resources (* button event-translations)
                          '(((:button-press :button-3) button-select)
                            ((:button-press :button-1) ignore-action)
                            ((:button-press :button-2) ignore-action)))
        (unless (y-or-n-p "~%Continue?") (return))



5.2 Application Resource Defaults

In describing the define-resources examples found in the beatlemenuia  function,
we have assumed that the optional defaults argument was omitted.  However,  this
argument can  be  used  to  specify  application-specific defaults for menu item
resources.   Notice  that   the  value   of  defaults   is  eventually   used in
resource-menu as  the  :defaults  argument  to  make-contact  when creating item
buttons.

The :defaults argument to make-contact is a property list of resource  initargs.
For example:

    (setf item-defaults '(:font "vrb-25" :background 0.5))

When a contact is created,  if a resource value  is not given in  a make-contact
initarg and no value can  be found in the  resource database, then its  value is
looked up  in  the  :defaults  list.   However,  resource  defaults found in the
resource database  override  any  value  in  the :defaults list.  Therefore, the
:defaults list is a convenient way for an application to accept user preferences
in the resource database but also to supply application-specific defaults if  no
user preferences are found.

For example, if  beatlemenuia is  invoked with  different application  defaults,
then menus displayed may look different.

    (setf item-defaults '(:font "vrb-25" :background 0.5))
    (beatlemenuia 'lm item-defaults)

This example causes the menu item labels to appear in the font named "vrb-25" in
Example  2.   However,  in  Example  3,  this  application-specific  default  is
overridden by the user's font choice in the resource database.  Similarly, items
have a gray background in Example 3, but not in Example 2.